home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / menu / toadmenu.arc / TOADMENU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-10-30  |  8.2 KB  |  240 lines
  1. PROGRAM toadmenu;
  2. (*
  3. Copyright (C) David P Kirschbaum  All Rights Reserved
  4.  
  5. I maintain the copyright and all commercial rights to TOADMENU.
  6. The program and source code, however, may be freely distributed, copied,
  7. and used for any purpose so long as the following conditions are met:
  8.  
  9.    Author's  name and copyright are not removed from the  program  or
  10.    source code.
  11.  
  12.    The  program  name  is not significantly  changed  from  TOADMENU.
  13.    (Version  numbers,  if patched,  may be indicated by replacing the
  14.    last character with the version number (TOADMEN1, TOADMEN2, etc.).
  15.  
  16.    All credits remain in the source code.
  17.  
  18.    Distribution or copying fees do not exceed $6.00.
  19.  
  20.    The  source code,  sample TOADMENU.DAT,  and documentation must be
  21.    distributed with the executable program.
  22.  
  23. Author:  David P Kirschbaum
  24.          Toad Hall
  25.          kirsch@braggvax.ARPA
  26.  
  27.  
  28. Credits:
  29.  
  30. AUTOMENU (TP_MENU.PAS) by Joseph G. Solch
  31.  
  32. EXEC.PAS
  33.  v1.1 -  Bela Lubkin
  34.          Borland International Technical Support
  35.          CompuServe 71016,1573
  36.  
  37.  v1.2 -  James Tuksal
  38.          Burroughs Corporation
  39.          14115 Farmington Rd.
  40.          Livonia, Michigan  48154
  41.  
  42. BOX.PAS by  DAVID W. TERRY   SEPT. 1, 1985
  43.         3036 PUTNAM CT.
  44.         WEST VALLEY CITY, UT 84120
  45. *)
  46.  
  47. {$V-}  {relax string parm testing}
  48. { R-}  {no runtime index checks}
  49. {$C-}  {No Ctrl C, Ctrl S checking}
  50.  
  51. {Compile with mIninum stack space = 100
  52.               mAximim stack space = 100
  53.  (required by the EXEC function)
  54. }
  55.  
  56. TYPE
  57.   Str20 = STRING[20];
  58.   Str40 = STRING[40];
  59.   Str64 = STRING[64];
  60.   Str78 = STRING[78];
  61.   Str80 = STRING[80];
  62.   Str255 = STRING[255];
  63.  
  64.   MenuItem      = Str20;                  {max length for a menu display}
  65.  
  66.   MenuSelection = ARRAY[1..20] OF Str20;  {menu display items}
  67.   CmdSelection  = ARRAY[1..20] OF Str64;  {item-associated DOS commands}
  68.   TxtSelection  = ARRAY[1..20] OF Str78;  {item-associated text}
  69.  
  70.   Regpack = RECORD CASE INTEGER OF
  71.               0 : (ax,bx,cx,dx,bp,si,di,ds,es,flags : INTEGER);
  72.               1 : (al,ah,bl,bh,cl,ch,dl,dh : BYTE);
  73.             END;
  74.  
  75.   curs_cond     = (on,off);
  76.  
  77. CONST
  78.   M_Y = 6;     {y coord for menu window top}
  79.   T_Y = 19;    {y coord for text window top (and menu window bottom)}
  80.  
  81.   Fkey : ARRAY[1..10] OF STRING[3] =    {string display of Func Keys}
  82.     ('F1 ', 'F2 ', 'F3 ', 'F4 ', 'F5 ',
  83.      'F6 ', 'F7 ', 'F8 ', 'F9 ', 'F10');
  84.  
  85.   SecKey : STRING[10] = ';<=>?@ABCD';   {2d char in Turbo Func Key}
  86.  
  87.   MenuTitle : STRING[12] = '  TOADMENU  ';  {title at top of menu}
  88.   default : INTEGER = 10;          {start at menu item 10 (always Exit) }
  89.  
  90. VAR
  91.   PALLETTE : BYTE ABSOLUTE $0000:$0466;  {system color pallette}
  92.   len,                             {global length variable}
  93.   maxlen,                          {remembers widest text or cmd}
  94.   x,y,                             {global coord variables}
  95.   z      : INTEGER;                {global variable}
  96.   Regs       : Regpack;
  97.  
  98.   Item       : MenuSelection;      {menu item}
  99.   Cmd        : CmdSelection;       {item-associated DOS commands}
  100.   Txt        : TxtSelection;       {item-associated text}
  101.   CmdParm    : Str80;              {any user cmd parms to pass to DOS}
  102.   MenuFile   : TEXT;               {text file with menus, cmds, txt}
  103.   oldcolor   : BYTE;               {save orig system pallette}
  104.   Color      : BOOLEAN;            {color or mono system}
  105.  
  106. {stuff from menu.inc}
  107.  
  108. VAR
  109.   minptr,maxptr,                   {legal range of menu items}
  110.   last,                            {remember last menuptr}
  111.   t_x,                             {text box left coords}
  112.   m_x,                             {menu box upper left x/y coords}
  113.   maxtxtlen,                       {max text length}
  114.   maxitemlen       : INTEGER;      {longest menu item}
  115.   HlChar           : STRING[20];   {desired highlighted chars}
  116.   hlcharpos        : ARRAY[1..20] OF INTEGER;  {each char's psn in
  117.                                                 its item string}
  118.   InChar           : CHAR;
  119.   LenOver10,         {TH}
  120.   FirstMenu        : BOOLEAN;
  121.   menuptr,
  122.   menulen          : 1..20;
  123.   CurrentDir       : Str64;     {remember current drive,subdir}
  124.   Legend           : Str40;
  125.  
  126.  
  127. (*
  128.   Types and variables for BOX procedure in MENUTIL.INC
  129. *)
  130.  
  131. TYPE
  132.   x_scrn_Type = ARRAY[1..2000] OF INTEGER;
  133.   y_scrn_Type = ARRAY[1..25,1..80] OF INTEGER;
  134.  
  135. VAR
  136.   x_scrn : ^x_scrn_Type;
  137.   y_scrn : ^y_scrn_Type;
  138.  
  139. {$I MENUTIL.INC}
  140. {$I MENU.INC}
  141. {$I NEWEXEC.INC}
  142.  
  143. BEGIN
  144.  
  145.   Assign(MenuFile,'TOADMENU.DAT');
  146.   {$I-}
  147.   Reset(MenuFile);                      {open our menu text file}
  148.   {$I+}
  149.   IF IOresult <> 0 THEN BEGIN           {failed somehow}
  150.     Writeln('TOADMENU cannot find its command file "TOADMENU.DAT"!');
  151.     Writeln('TOADMENU aborting!');
  152.   END;
  153.  
  154.   ClrScr;
  155.   HlChar := '                    ';     {initialize to all blanks}
  156.  
  157.   {Format of file should be:
  158.    B,Basic,*GWBASIC%
  159.    where first fieldr is the desired highlighted char,
  160.    second field is the desired menu display,
  161.    third field is the appropriate DOS command line stub (if any).
  162.    Second line in the text file is item-associated text (or blank).
  163.   }
  164.   menuptr := 1;
  165.   maxtxtlen := 20;                      {minimum text window width}
  166.   maxitemlen := 12;                     {minimum menu window width}
  167.  
  168.   {Just using CmdParm here as a working string}
  169.   WHILE (NOT EOF(MenuFile)) AND (menuptr < 21) DO BEGIN
  170.     Readln(MenuFile,CmdParm);           {actual Menu item display}
  171.     IF CmdParm[1] <> ';' THEN BEGIN     {not a comment}
  172.       HlChar[menuptr] := CmdParm[1];    {first char is highlight char}
  173.       Delete(CmdParm,1,2);              {gobble char, comma}
  174.       x := POS(',', CmdParm);           {find end of 2d field}
  175.       IF x > 0 THEN BEGIN               {we have a 3d field}
  176.         Item[menuptr] := Copy(CmdParm,1,PRED(x));{copy 2d parm}
  177.         Delete(CmdParm,1,x);            {delete 2d parm, comma}
  178.       END
  179.       ELSE BEGIN
  180.         Item[menuptr] := CmdParm;       {read in what we got}
  181.         CmdParm := '';                  {blank out for DOS cmd}
  182.       END;
  183.       len := LENGTH(Item[menuptr]);     {get item length}
  184.       IF len > maxitemlen               {find the longest item}
  185.       THEN maxitemlen := len;           {and remember its length}
  186.  
  187.       Cmd[menuptr] := CmdParm;          {may be blank}
  188.       Readln(MenuFile,Txt[menuptr]);    {read in associated text}
  189.       len := LENGTH(Txt[menuptr]);      {may be blank}
  190.       IF len > maxtxtlen THEN maxtxtlen := len;  {remember longest}
  191.       menuptr := SUCC(menuptr);         {bump counter}
  192.     END;
  193.   END;
  194.   Item[menuptr] := '';                  {terminate with blank item}
  195.   menulen := PRED(menuptr);
  196.   maxitemlen := maxitemlen + 8;         {need it wider}
  197.   Close(MenuFile);
  198.  
  199.   Init_Menu;                            {initialize menu vars}
  200.  
  201.   Repeat
  202.     CmdParm := '';                      {Clear the DOS command parm}
  203.  
  204.     z := menu;                          {do the menu}
  205.  
  206.     IF CmdParm <> '' THEN BEGIN         {Any DOS command parm returned?}
  207.       IF CmdParm[1] = '*'               {we need COMMAND.COM}
  208.       THEN CmdParm := GetComSpec+' /C '+COPY (CmdParm, 2, 78);
  209.       x := subProcess(CmdParm);         {do the Exec}
  210.       IF x <> 0 THEN BEGIN              {DOS-returned value}
  211.         GotoXY(1,24);
  212.         WRITE ('ToadMenu DOS Returned :',x, ' [');
  213.         CASE x OF
  214.           {0: Writeln('Success'); }
  215.           1: Writeln('Invalid function]');
  216.           2: Writeln('File/path not found]');
  217.           8: Writeln('Not enough memory to load program]');
  218.          10: Writeln('Bad environment (greater than 32K)]');
  219.          11: Writeln('Illegal .EXE file format]');
  220.          ELSE Writeln('DOS returned value]');
  221.         END;  {case}
  222.       END;
  223.  
  224.       IF Color THEN BEGIN               {Illuminate prompt}
  225.         TextColor(WHITE);
  226.         TextBackGround(RED);
  227.       END
  228.       ELSE RvsOn;
  229.       GotoXY(1,25);
  230.       Write('ToadMenu: press any key: ');
  231.       Repeat Until Keypressed; Read(Kbd,Inchar);  {wait for user}
  232.       RvsOff;
  233.       InChar := ' ';
  234.     END;  {we got a parm}
  235.   UNTIL z = default;                  {default is Exit}
  236.  
  237.   ChDir(CurrentDir);                  {return to starting drive\dir}
  238.   PALLETTE := oldcolor;               {restore orig pallette}
  239. END.
  240.